17 October review
New Data review : “C:\20251016scholars.Rda”
library(readxl)
library(selenider)
library(rvest)
library(tidyverse)
library(netstat)
library(pingr)
library(jsonlite)
library(stringr)
library(openalexR)
library(readxl)
packages <- c("tidyverse", "scholar", "openalexR", "rvest", "jsonlite")
packages <- c("devtools", "igraph")
fpackage.check <- function(packages) {
lapply(packages, FUN = function(x) {
if (!require(x, character.only = TRUE)) {
install.packages(x, dependencies = TRUE)
library(x, character.only = TRUE)
}
})
}
fsave <- function(x, file = NULL, location = "./data/processed/") {
ifelse(!dir.exists("data"), dir.create("data"), FALSE)
ifelse(!dir.exists("data/processed"), dir.create("data/processed"), FALSE)
if (is.null(file))
file = deparse(substitute(x))
datename <- substr(gsub("[:-]", "", Sys.time()), 1, 8)
totalname <- paste(location, file, "_", datename, ".rda", sep = "")
save(x, file = totalname) #need to fix if file is reloaded as input name, not as x.
}
fload <- function(filename) {
load(filename)
get(ls()[ls() != "filename"])
}
fshowdf <- function(x, ...) {
knitr::kable(x, digits = 2, "html", ...) %>%
kableExtra::kable_styling(bootstrap_options = c("striped", "hover")) %>%
kableExtra::scroll_box(width = "100%", height = "300px")
}
scholars <- fload("C:/Github/labjournal/20251016scholars.Rda")
fcolnet = function(data = scholars, university = c("RU", 'UU'), discipline = "Sociologie", waves = list(c(2015,
2018), c(2019, 2023), c(2024, 2025)), type = c("first")) {
university = paste0('(', paste0(university, collapse='|' ), ')')
discipline = paste0('(', paste0(discipline, collapse='|' ), ')')
# step 1
demographics = data$demographics
sample = which(
(str_detect(demographics$universiteit.22, university)
| str_detect(demographics$universiteit.24, university)
| str_detect(demographics$universiteit.25, university)
) & (
str_detect(demographics$discipline.22, discipline)
| str_detect(demographics$discipline.24, discipline)
| str_detect(demographics$discipline.25, discipline)
) |> replace_na(FALSE))
demographics_soc = demographics[sample, ] |> drop_na(id)
# step 2
ids = demographics_soc$id |> unique()
scholars_sel = list()
for (id_ in ids){
scholars_sel[[id_]] = bind_rows(scholars$works) |>
filter(author_id == id_)
}
scholars_sel = bind_rows(scholars$works)
nwaves = length(waves)
nets = array(0, dim = c(nwaves, length(ids), length(ids)), dimnames = list(wave = 1:nwaves, ids,
ids))
dimnames(nets)
# step 3
df_works = tibble(
works_id = scholars_sel$id,
works_author = scholars_sel$authorships,
works_year = scholars_sel$publication_year
)
df_works = df_works[!duplicated(df_works), ]
# step 4
if (type == "first") {
for (j in 1:length(waves)) {
df_works_w = df_works[df_works$works_year >= waves[[j]][1] & df_works$works_year <= waves[[j]][2],
]
for (i in 1:nrow(df_works_w)) {
ego = df_works_w$works_author[i][[1]]$id[1]
alters = df_works_w$works_author[i][[1]]$id[-1]
if (sum(ids %in% ego) > 0 & sum(ids %in% alters) > 0) {
nets[j, which(ids %in% ego), which(ids %in% alters)] = 1
}
}
}
}
if (type == "last") {
for (j in 1:length(waves)) {
df_works_w = df_works[df_works$works_year >= waves[[j]][1] & df_works$works_year <= waves[[j]][2],
]
for (i in 1:nrow(df_works_w)) {
ego = rev(df_works_w$works_author[i][[1]]$id[1])
alters = rev(df_works_w$works_author[i][[1]]$id[-1])
if (sum(ids %in% ego) > 0 & sum(ids %in% alters) > 0) {
nets[j, which(ids %in% ego), which(ids %in% alters)] = 1
}
}
}
}
if (type == "all") {
for (j in 1:length(waves)) {
df_works_w = df_works[df_works$works_year >= waves[[j]][1] & df_works$works_year <= waves[[j]][2],
]
for (i in 1:nrow(df_works_w)) {
egos = df_works_w$works_author[i][[1]]$id
if (sum(ids %in% egos) > 0) {
nets[j, which(ids %in% egos), which(ids %in% egos)] = 1
}
}
diag(nets[j,,]) = 0
}
}
output = list()
output$data = demographics_soc
output$nets = nets
return(output)
}
packages = c(
"RSiena", "tidyverse",
'dplyr', 'stringr' # these packages were added to make the code run
)
fpackage.check(packages)
[[1]]
NULL
[[2]]
NULL
[[3]]
NULL
[[4]]
NULL
# from Jos code - Radboud and Utrecht
test1 = fcolnet(scholars, university = c('RU', 'UU'))
df_ego1 = bind_rows(test1$data)
# Radboud only (where I want to start)
test = fcolnet(scholars, university = c("RU")) #only Radboud
df_ego = bind_rows(test$data)
wave1 = test$nets[1,,]
wave2 = test$nets[2,,]
wave3 = test$nets[3,,]
nets = array(
data = c(wave1, wave2, wave3),
dim = c(dim(wave2), 2)
)
net = sienaDependent(nets)
# Example from recoding function
#df_ego = df_ego |>
# mutate(
# funcs = case_when(
# functie.22 == "Full Professor" ~ 1,
# functie.24 == "Full Professor" ~ 1,
# functie.25 == "Full Professor" ~ 1,
# .default = 0
# )
# )
# Recoding for gender
df_ego = df_ego |>
mutate(
female = case_when(
gender == "female" ~ 1,
.default = 0
)
)
female = coCovar(df_ego$female)
# make adjacency matrix with first wave of data
test_wave1ru <- igraph::graph_from_adjacency_matrix(
test$nets[1,,], #for this example I take the first wave of data. (thus I select the array of networks and take the first matrix)
mode = c("directed"),
weighted = NULL,
diag = FALSE,
add.colnames = NULL,
add.rownames = NULL
)
#plot to see if it worked
plot(test_wave1ru,
vertex.color = ifelse(df_ego$female == 1, "red", "blue"),
vertex.label = NA,
edge.width = 0.2,
edge.arrow.size =0.2)
dim(test_wave1ru) #check it works
NULL
sum(is.na(test_wave1ru)) #check it is complete -- if 0 missing values
[1] 0
test_wave2ru <- igraph::graph_from_adjacency_matrix(
test$nets[2,,], #for this example I take the first wave of data. (thus I select the array of networks and take the first matrix)
mode = c("directed"),
weighted = NULL,
diag = FALSE,
add.colnames = NULL,
add.rownames = NULL
)
#plot to see if it worked
plot(test_wave2ru,
vertex.color = ifelse(df_ego$female == 1, "red", "blue"),
vertex.label = NA,
edge.width = 0.2,
edge.arrow.size =0.2)
test_wave3ru <- igraph::graph_from_adjacency_matrix(
test$nets[3,,], #for this example I take the first wave of data. (thus I select the array of networks and take the first matrix)
mode = c("directed"),
weighted = NULL,
diag = FALSE,
add.colnames = NULL,
add.rownames = NULL
)
#plot to see if it worked
plot(test_wave3ru,
vertex.color = ifelse(df_ego$female == 1, "red", "blue"),
vertex.label = NA,
edge.width = 0.2,
edge.arrow.size =0.2)
igraph::transitivity(test_wave3ru, type = c("localundirected"), isolates = c("NaN", "zero"))
https://openalex.org/A5025020830 https://openalex.org/A5107108074 https://openalex.org/A5062356007 https://openalex.org/A5011326378
NaN NaN NaN NaN
https://openalex.org/A5055990297 https://openalex.org/A5040086999 https://openalex.org/A5010764981 https://openalex.org/A5042713882
0.04761905 NaN 0.00000000 NaN
https://openalex.org/A5093927073 https://openalex.org/A5047911137 https://openalex.org/A5072634827 https://openalex.org/A5116748350
1.00000000 NaN NaN 0.00000000
https://openalex.org/A5046746723 https://openalex.org/A5085082439 https://openalex.org/A5004797389 https://openalex.org/A5059244275
0.66666667 NaN NaN NaN
https://openalex.org/A5063338887 https://openalex.org/A5107698575 https://openalex.org/A5038364313 https://openalex.org/A5071959536
NaN NaN 0.00000000 NaN
https://openalex.org/A5083298960 https://openalex.org/A5025639524 https://openalex.org/A5030685996 https://openalex.org/A5037616102
NaN NaN 0.00000000 NaN
https://openalex.org/A5002770121 https://openalex.org/A5060194739 https://openalex.org/A5056184618 https://openalex.org/A5104227161
NaN NaN 0.00000000 NaN
https://openalex.org/A5048074496 https://openalex.org/A5062173114 https://openalex.org/A5058254351 https://openalex.org/A5099033606
0.00000000 NaN 0.00000000 NaN
https://openalex.org/A5056774186 https://openalex.org/A5084918963 https://openalex.org/A5047687982 https://openalex.org/A5066699568
NaN NaN NaN 0.00000000
https://openalex.org/A5043015269 https://openalex.org/A5029360150 https://openalex.org/A5045280782 https://openalex.org/A5030658869
0.00000000 NaN NaN NaN
https://openalex.org/A5056557463 https://openalex.org/A5024195666 https://openalex.org/A5103523883 https://openalex.org/A5093330363
NaN NaN NaN NaN
https://openalex.org/A5085123027 https://openalex.org/A5035350135 https://openalex.org/A5086908160 https://openalex.org/A5026623706
NaN 0.16666667 0.00000000 0.00000000
https://openalex.org/A5102070907 https://openalex.org/A5068642001 https://openalex.org/A5075816665 https://openalex.org/A5104078567
NaN NaN NaN NaN
https://openalex.org/A5064646891 https://openalex.org/A5075710125 https://openalex.org/A5048218319 https://openalex.org/A5037423746
NaN NaN NaN NaN
https://openalex.org/A5040385638 https://openalex.org/A5080235042 https://openalex.org/A5038009917 https://openalex.org/A5081499440
NaN NaN NaN NaN
https://openalex.org/A5050680074 https://openalex.org/A5058115048 https://openalex.org/A5100375099 https://openalex.org/A5087380803
NaN NaN NaN 0.30000000
https://openalex.org/A5065325810 https://openalex.org/A5041095675 https://openalex.org/A5017382943 https://openalex.org/A5050786452
1.00000000 NaN NaN NaN
https://openalex.org/A5023395007 https://openalex.org/A5055096981 https://openalex.org/A5016089551 https://openalex.org/A5091348904
NaN 0.00000000 NaN NaN
https://openalex.org/A5031002485 https://openalex.org/A5042331969 https://openalex.org/A5066092617 https://openalex.org/A5017636151
0.00000000 NaN NaN NaN
https://openalex.org/A5017637321 https://openalex.org/A5082749336 https://openalex.org/A5018242597 https://openalex.org/A5080593921
NaN NaN NaN NaN
https://openalex.org/A5053506252 https://openalex.org/A5074062335 https://openalex.org/A5038843493 https://openalex.org/A5019799886
NaN NaN 0.33333333 NaN
https://openalex.org/A5023362052 https://openalex.org/A5085493990 https://openalex.org/A5048125830 https://openalex.org/A5003892082
NaN NaN NaN 0.00000000
https://openalex.org/A5002388922 https://openalex.org/A5064349318 https://openalex.org/A5018212005 https://openalex.org/A5112383954
NaN NaN 0.00000000 NaN
https://openalex.org/A5038425122 https://openalex.org/A5019957971 https://openalex.org/A5040600354 https://openalex.org/A5037069958
NaN NaN 0.00000000 1.00000000
https://openalex.org/A5060015711 https://openalex.org/A5020765315 https://openalex.org/A5095856216 https://openalex.org/A5082048045
0.33333333 NaN NaN NaN
https://openalex.org/A5007673492 https://openalex.org/A5043004626 https://openalex.org/A5025668614 https://openalex.org/A5048988743
NaN NaN NaN 0.00000000
https://openalex.org/A5078173090 https://openalex.org/A5009655338 https://openalex.org/A5004733423 https://openalex.org/A5016107698
NaN 1.00000000 NaN 0.00000000
https://openalex.org/A5035502020 https://openalex.org/A5050683616 https://openalex.org/A5006416152 https://openalex.org/A5112742337
0.10000000 NaN NaN NaN
https://openalex.org/A5012137641 https://openalex.org/A5030092568 https://openalex.org/A5012273953 https://openalex.org/A5023494442
NaN NaN 0.00000000 NaN
https://openalex.org/A5031371982 https://openalex.org/A5068000059 https://openalex.org/A5032041950 https://openalex.org/A5017129862
0.00000000 NaN 0.00000000 NaN
https://openalex.org/A5030977100 https://openalex.org/A5063497971 https://openalex.org/A5102793963 https://openalex.org/A5018479981
NaN 0.00000000 NaN NaN
https://openalex.org/A5079372810 https://openalex.org/A5020071821 https://openalex.org/A5017879057 https://openalex.org/A5013258554
NaN NaN NaN 0.00000000
https://openalex.org/A5002265802 https://openalex.org/A5006081433 https://openalex.org/A5021227718 https://openalex.org/A5065130106
NaN NaN NaN 0.00000000
https://openalex.org/A5062608377 https://openalex.org/A5068892781 https://openalex.org/A5045288860 https://openalex.org/A5085013298
0.00000000 NaN NaN 0.33333333
https://openalex.org/A5061402160 https://openalex.org/A5078518573 https://openalex.org/A5046585291 https://openalex.org/A5019204497
NaN NaN NaN 0.00000000
https://openalex.org/A5087435392 https://openalex.org/A5042405723 https://openalex.org/A5001803910 https://openalex.org/A5044445824
NaN NaN 0.33333333 NaN
https://openalex.org/A5081620696 https://openalex.org/A5066781342 https://openalex.org/A5057934803 https://openalex.org/A5033572980
0.00000000 NaN NaN NaN
https://openalex.org/A5084821293 https://openalex.org/A5039921154 https://openalex.org/A5008459416 https://openalex.org/A5022243966
0.00000000 NaN NaN 0.33333333
https://openalex.org/A5065278343 https://openalex.org/A5074532622 https://openalex.org/A5113457866 https://openalex.org/A5059043231
NaN NaN NaN NaN
https://openalex.org/A5013379944 https://openalex.org/A5000347656 https://openalex.org/A5026156805 https://openalex.org/A5064944446
0.00000000 0.00000000 NaN NaN
igraph::triad.census(test_wave3ru) #with plot -- works
[1] 658675 10658 462 28 68 13 8 2 5 0 0 0 0 0 1 0
sna::triad.census(test$nets[2,,])
003 012 102 021D 021U 021C 111D 111U 030T 030C 201 120D 120U 120C 210 300
[1,] 650587 16986 1963 37 189 58 56 10 14 0 1 8 4 4 2 1
unloadNamespace("sna") #I will detach this package again
triad_w2ru <- data.frame(sna::triad.census(test$nets[2,,])) #save as df
igraph::transitivity(test_wave2ru, type = "global")
[1] 0.22
# Returns: [1] 0.22
sna::gtrans(test$nets[2,,]) #triad census a different way
[1] 0.2842105
# Returns: [1] 0.2842105
transitivity_w2 <- (3 * triad_w2ru$X300)/(triad_w2ru$X201 + 3 * triad_w2ru$X300) #X300 is variable for transitive triad (the fully closed triad)
# we multiply by 3 because there are 3 possible transitive triads
transitivity_w2
[1] 0.75
# Returns: [1] 0.75
# Wave 3
sna::triad.census(test$nets[3,,])
003 012 102 021D 021U 021C 111D 111U 030T 030C 201 120D 120U 120C 210 300
[1,] 658675 10658 462 28 68 13 8 2 5 0 0 0 0 0 1 0
# Returns: 003 012 102 021D 021U 021C 111D 111U 030T 030C 201 120D 120U 120C 210 300
# [1,] 658675 10658 462 28 68 13 8 2 5 0 0 0 0 0 1 0
unloadNamespace("sna") #I will detach this package again
triad_w3ru <- data.frame(sna::triad.census(test$nets[3,,])) #save as df
igraph::transitivity(test_wave3ru, type = "global")
[1] 0.1313869
# Returns: [1] 0.1313869
sna::gtrans(test$nets[3,,]) #triad census a different way
[1] 0.25
# Returns: [1] 0.25
transitivity_w3 <- (3 * triad_w3ru$X300)/(triad_w3ru$X201 + 3 * triad_w3ru$X300) #X300 is variable for transitive triad (the fully closed triad)
# we multiply by 3 because there are 3 possible transitive triads
transitivity_w3
[1] NaN
# Returns: [1] NaN
NEED TO INCLUDE TRIADS - TRANSITIVITY OUTDEGREE AND RECIPROCITY ARE ALWAYS IN THERE, ALSO NEED OUTDEGREE ACTIVITY OR IN DEGREE POPULARITY. ALSO NEED SOMETHING FOR TRANSITIVITY - GWESP VARIABLE AND EFFECTS TO INCLUDE - MAKE SURE TO INCLUDE ONE OF THESE TOO.
fpackage.check(packages)
[[1]]
NULL
Independent variable: gender?
We already know: net <- sienaDependent(nets) (dependent variable) Dependent variable: ties = [net]
mydata <- sienaDataCreate(net, gender) #buggy - why doesnt this work??
Error in sienaDataCreate(net, gender) :
constant covariate incorrect node set: gender
effectsDocumentation(myeff)
print01Report(mydata)
# gives initial description of data
# reading network variables , covariates, density measures/changes in networks, tie changes between subsequent observations... calculate how much networks changed over time.
# dont use balance calculation
Example:
net1g <- graph_from_adjacency_matrix(ts_net1, mode = "directed")
coords <- layout_(net1g, nicely()) #let us keep the layout
par(mar = c(0.1, 0.1, 0.1, 0.1))
{
plot.igraph(net1g, layout = coords)
graphics::box()
}
# for every actor, there are 10 options - each actor can break tie, keep tie/do nothing, or add new tie. If tie, can break or keep. If there is no tie, can remain 0 tie or form a tie.
# Now, select 'random' agent:
set.seed(24553253)
ego <- ts_select(net = ts_net1)
ego
#### Network: ts_net1, ego = ego4 (ego 4 allowed to make ministeps). package then will list all of the different adjacency matrices. Shows all of the different next ministep options for ego 4.
####
options <- ts_alternatives_ministep(net = ts_net1, ego = ego)
options
plots <- lapply(options, graph_from_adjacency_matrix, mode = "directed")
par(mar = c(0, 0, 0, 0) + 0.1)
par(mfrow = c(2, 2))
fplot <- function(x) {
plot.igraph(x, layout = coords, margin = 0)
graphics::box()
}
ts_degree(net = options[[1]], ego = ego)
sapply(options, ts_degree, ego = ego)
IF NEEDED LATER: